Análisis de Datos

Dr. Oldemar Rodríguez R.

library("FactoMineR") 
library("factoextra")

# Valores de los gráficos por defecto
mi.tema <- theme_grey() + theme(panel.border = element_rect(fill = NA,color = "white"), plot.title = element_text(hjust = 0.5))

Clustering Jerárquico

Usando la agregación del Salto Máximo(method = “complete”)

setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method = "complete")

Tipos de Gráficos

Por defecto (hclust de stats)

plot(modelo)

plot(modelo,hang = -1)
# la siguiente instrucción separa los clústeres usando 3
rect.hclust(modelo, k=3, border="red")

Usando factoextra

fviz_dend(modelo, cex = 1.3,ggtheme = mi.tema)

# la siguiente instrucción separa los clústeres usando 3
fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)

Usando la agregación del Salto Mínimo(method = “single”)

setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method = "single")

Tipos de Gráficos

Por defecto (hclust de stats)

plot(modelo,hang=-1)
rect.hclust(modelo, k=3, border="blue")

Usando factoextra

fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)

Usando la agregación del Promedio (method = “average”)

setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method = "average")

Tipos de Gráficos

Por defecto (hclust de stats)

plot(modelo)
rect.hclust(modelo, k=3, border="green")

Usando factoextra

fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)

Usando la agregación de Ward (method= “ward.D”)

setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method= "ward.D")

Tipos de Gráficos

Por defecto (hclust de stats)

plot(modelo,hang=-1)
rect.hclust(modelo, k=3, border="magenta")

Usando factoextra

fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)

Guardando la tabla de datos con el cluster al que pertenece cada individuo

# cutree corta el el árbol con k clústeres
Grupo<-cutree(modelo,k=3)
NDatos<-cbind(Datos,Grupo)
NDatos

##        Matematicas Ciencias Espanol Historia EdFisica Grupo
## Lucia          7.0      6.5     9.2      8.6      8.0     1
## Pedro          7.5      9.4     7.3      7.0      7.0     2
## Ines           7.6      9.2     8.0      8.0      7.5     2
## Luis           5.0      6.5     6.5      7.0      9.0     3
## Andres         6.0      6.0     7.8      8.9      7.3     1
## Ana            7.8      9.6     7.7      8.0      6.5     2
## Carlos         6.3      6.4     8.2      9.0      7.2     1
## Jose           7.9      9.7     7.5      8.0      6.0     2
## Sonia          6.0      6.0     6.5      5.5      8.7     3
## Maria          6.8      7.2     8.7      9.0      7.0     1

# Establezco el directorio en donde se quiere grabar el archivo
setwd("~/Google Drive/MDCurso/Datos")
# Se graba el archivo en como un CSV
write.csv(NDatos,"NDatos.csv")

Clustering sobre las componentes Principales

# Ejemplo de las importaciones de México
setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('ImportacionesMexico.csv', header=TRUE, sep=';',dec=',',row.names=1)
res  <- PCA(Datos , scale.unit=TRUE, ncp=5, graph = FALSE)
res.hcpc <- HCPC(res, nb.clust = -1, consol = TRUE, min = 3, max = 3, graph = FALSE)

plot.HCPC(res.hcpc, choice="bar")

Tipos de Gráficos

Por defecto (FactoMineR)

plot.HCPC(res.hcpc, choice="map",select="cos2 0.1")

Usando factoextra

fviz_cluster(res.hcpc,repel = TRUE,show.clust.cent = TRUE,palette = "jco",main = "Factor map",geom = "text", select.ind = list(cos2 = 0.1))

plot.HCPC(res.hcpc, choice="3D.map", angle=60)

Interpretación de los clusteres mediante los centroides

library(cluster) # Para menejo de clusteres

# Función para encontrar el centroide de cada cluster
centroide <- function(num.cluster, datos, clusters) {
  ind <- (clusters == num.cluster)
  return(colMeans(datos[ind,]))
}

setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method= "ward.D")

grupos <- cutree(modelo, k=3)
grupos

##  Lucia  Pedro   Ines   Luis Andres    Ana Carlos   Jose  Sonia  Maria 
##      1      2      2      3      1      2      1      2      3      1

centro.cluster1<-centroide(1,Datos,grupos)
centro.cluster1

## Matematicas    Ciencias     Espanol    Historia    EdFisica 
##       6.525       6.525       8.475       8.875       7.375

centro.cluster2<-centroide(2,Datos,grupos)
centro.cluster2

## Matematicas    Ciencias     Espanol    Historia    EdFisica 
##       7.700       9.475       7.625       7.750       6.750

centro.cluster3<-centroide(3,Datos,grupos)
centro.cluster3

## Matematicas    Ciencias     Espanol    Historia    EdFisica 
##        5.50        6.25        6.50        6.25        8.85

centros<-rbind(centro.cluster1,centro.cluster2,centro.cluster3)
centros

##                 Matematicas Ciencias Espanol Historia EdFisica
## centro.cluster1       6.525    6.525   8.475    8.875    7.375
## centro.cluster2       7.700    9.475   7.625    7.750    6.750
## centro.cluster3       5.500    6.250   6.500    6.250    8.850

color <- c("#ECD078","#D95B43","#C02942","#542437","#53777A")
barplot(centros[1,],col=color,las=2, cex.names = 0.8, ylim = c(0,10))

barplot(centros[2,],col=color,las=2, cex.names = 0.8, ylim = c(0,10))

barplot(centros[3,],beside=TRUE,col=color,las=2, cex.names = 0.8, ylim = c(0,10))

barplot(t(centros),beside=TRUE,col=color, cex.names = 0.8, ylim = c(0,10))

Interpretación con Gráficos Tipo Estrella (Tipo Araña, Tipo Radar)

centros<-as.data.frame(centros)
maximos<-apply(centros,2,max)
minimos<-apply(centros,2,min)
centros<-rbind(minimos,centros)
centros<-rbind(maximos,centros)
centros

##                 Matematicas Ciencias Espanol Historia EdFisica
## 1                     7.700    9.475   8.475    8.875    8.850
## 11                    5.500    6.250   6.500    6.250    6.750
## centro.cluster1       6.525    6.525   8.475    8.875    7.375
## centro.cluster2       7.700    9.475   7.625    7.750    6.750
## centro.cluster3       5.500    6.250   6.500    6.250    8.850

library(fmsb) # Paquete para usar radarchart

color <- c("#CC333F","#EB6841","#EDC951")
radarchart(as.data.frame(centros),maxmin=TRUE,axistype=4,axislabcol="slategray4",
             centerzero=FALSE,seg=8, cglcol="gray67",
             pcol=color,plty=1,plwd=5,title="Comparación de clústeres")
  
legenda <-legend(1.5,1, legend=c("Cluster 1","Cluster 2","Cluster 3"),
                seg.len=-1.4,title="Clústeres",pch=21,bty="n" ,lwd=3, y.intersp=1, 
                horiz=FALSE,col=color)

Ejemplo Servicio al Cliente

setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploClientesCorregidaEdad.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method= "ward.D")

Tipos de Gráficos

Por defecto (hclust de stats)

plot(modelo,las=1,hang=-1)

Usando factoextra

fviz_dend(modelo, cex = 1,ggtheme = mi.tema)

# Para encontrar el centroide de cada cluster
grupos <- cutree(modelo, k=3)
centro.cluster1<-centroide(1,Datos,grupos)
centro.cluster2<-centroide(2,Datos,grupos)
centro.cluster3<-centroide(3,Datos,grupos)
centros<-rbind(centro.cluster1,centro.cluster2,centro.cluster3)

color <- c("#FF6449", "#FEB035", "#FCE020", "#F7EC69", "#F1F8BE","#D5B9F6",
           "#A2E3CD","#EDF380", "#D8FD9C", "#AEEC64", "#F598F8", "#9EFF37")
barplot(centros[1,],col=color,las=2,cex.names = 0.65, ylim = c(0,12))

barplot(centros[2,],col=color,las=2, cex.names = 0.65, ylim = c(0,12))

barplot(centros[3,],beside=TRUE,col=color,las=2, cex.names = 0.65, ylim = c(0,12))

barplot(t(centros),beside=TRUE,legend=colnames(Datos),main = "Gráfico de Interpretación de Clases",col=color, cex.names = 0.65, ylim = c(0,25))

Gráficos Tipo Estrella (Tipo Araña, Tipo Radar) - Ejemplo Servicio al Cliente

centros<-as.data.frame(centros)
maximos<-apply(centros,2,max)
minimos<-apply(centros,2,min)
centros<-rbind(minimos,centros)
centros<-rbind(maximos,centros)
centros

##                  Edad.10 Antiguedad Espacios.Parqueo Velocidad.Cajas
## 1               3.080000   5.833333         6.850000            8.34
## 11              2.360000   0.600000         5.466667            7.44
## centro.cluster1 2.360000   0.600000         6.220000            8.34
## centro.cluster2 3.066667   5.833333         6.850000            8.10
## centro.cluster3 3.080000   3.000000         5.466667            7.44
##                 Distribucion.Productos Atencion.Empleados
## 1                             8.120000           9.713333
## 11                            4.626667           9.508333
## centro.cluster1               8.120000           9.700000
## centro.cluster2               7.600000           9.508333
## centro.cluster3               4.626667           9.713333
##                 Calidad.Instalaciones Ubicacion Limpieza
## 1                            4.700000  9.160000 7.450000
## 11                           2.406667  8.833333 5.626667
## centro.cluster1              4.700000  9.160000 7.360000
## centro.cluster2              3.500000  8.833333 7.450000
## centro.cluster3              2.406667  9.026667 5.626667
##                 Variedad.Productos Prestigio.Empresa Calidad.Servicio
## 1                         7.466667          8.520000            5.325
## 11                        5.960000          5.426667            4.960
## centro.cluster1           7.440000          8.520000            5.070
## centro.cluster2           7.466667          7.933333            5.325
## centro.cluster3           5.960000          5.426667            4.960

color <- c("#61492D","#939C53","#F3D079")

radarchart(as.data.frame(centros),maxmin=TRUE,axistype=4,axislabcol="slategray4",
             centerzero=FALSE,seg=8, cglcol="gray67",
             pcol=color,plty=1,plwd=5,title="Comparación de clústeres")
  
legenda <-legend(1.5,1, legend=c("Cluster 1","Cluster 2","Cluster 3"),
                seg.len=-1.4,title="Clústeres",pch=21,bty="n" ,lwd=3, y.intersp=1, 
                horiz=FALSE,col=color)

Clustering para variables cualitativas con biblioteca “cluster”

La función “daisy” de la biblioteca “cluster” permite calcular la matriz de distancias en tablas de datos cuyas variables están mezcladas entre variables cualtitativas y cuantitativas.

library(cluster)
setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.csv("SAheart.csv",header=TRUE, sep=";", dec=".")
str(Datos)

## 'data.frame':    462 obs. of  10 variables:
##  $ sbp      : int  160 144 118 170 134 132 142 114 114 132 ...
##  $ tobacco  : num  12 0.01 0.08 7.5 13.6 6.2 4.05 4.08 0 0 ...
##  $ ldl      : num  5.73 4.41 3.48 6.41 3.5 6.47 3.38 4.59 3.83 5.8 ...
##  $ adiposity: num  23.1 28.6 32.3 38 27.8 ...
##  $ famhist  : Factor w/ 2 levels "Absent","Present": 2 1 2 2 2 2 1 2 2 2 ...
##  $ typea    : int  49 55 52 51 60 62 59 62 49 69 ...
##  $ obesity  : num  25.3 28.9 29.1 32 26 ...
##  $ alcohol  : num  97.2 2.06 3.81 24.26 57.34 ...
##  $ age      : int  52 63 46 58 49 45 38 58 29 53 ...
##  $ chd      : Factor w/ 2 levels "No","Si": 2 2 1 2 2 1 1 2 1 2 ...

dim(Datos)

## [1] 462  10

head(Datos)

##   sbp tobacco  ldl adiposity famhist typea obesity alcohol age chd
## 1 160   12.00 5.73     23.11 Present    49   25.30   97.20  52  Si
## 2 144    0.01 4.41     28.61  Absent    55   28.87    2.06  63  Si
## 3 118    0.08 3.48     32.28 Present    52   29.14    3.81  46  No
## 4 170    7.50 6.41     38.03 Present    51   31.99   24.26  58  Si
## 5 134   13.60 3.50     27.78 Present    60   25.99   57.34  49  Si
## 6 132    6.20 6.47     36.21 Present    62   30.77   14.14  45  No

D<-daisy(Datos, metric = "euclidean")

## Warning in daisy(Datos, metric = "euclidean"): with mixed variables, metric
## "gower" is used automatically

jer<-hclust(D, method = "complete")

Tipos de Gráficos

Por defecto (rect.hclust de stats)

plot(jer)
rect.hclust(jer, k = 3, border = "red")

Usando factoextra

fviz_dend(jer, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#515151", "#F38630", "#00B4FF", "#ECD078"), ggtheme = mi.tema, show_labels = F)

Warning in get_col(col, k): Length of color vector was longer than the
number of clusters - first k elements are used

grupo<-cutree(jer, k = 3)
NDatos<-cbind(Datos,grupo)
head(NDatos)

##   sbp tobacco  ldl adiposity famhist typea obesity alcohol age chd grupo
## 1 160   12.00 5.73     23.11 Present    49   25.30   97.20  52  Si     1
## 2 144    0.01 4.41     28.61  Absent    55   28.87    2.06  63  Si     2
## 3 118    0.08 3.48     32.28 Present    52   29.14    3.81  46  No     3
## 4 170    7.50 6.41     38.03 Present    51   31.99   24.26  58  Si     1
## 5 134   13.60 3.50     27.78 Present    60   25.99   57.34  49  Si     1
## 6 132    6.20 6.47     36.21 Present    62   30.77   14.14  45  No     3

Interpretación usando solamente las Variables Cuantitativas (Numéricas)

# Se deben quitar las variables cualitativas para hacer un gráfico tipo araña
setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.csv("SAheart.csv",header=TRUE, sep=";", dec=".")
str(Datos)

## 'data.frame':    462 obs. of  10 variables:
##  $ sbp      : int  160 144 118 170 134 132 142 114 114 132 ...
##  $ tobacco  : num  12 0.01 0.08 7.5 13.6 6.2 4.05 4.08 0 0 ...
##  $ ldl      : num  5.73 4.41 3.48 6.41 3.5 6.47 3.38 4.59 3.83 5.8 ...
##  $ adiposity: num  23.1 28.6 32.3 38 27.8 ...
##  $ famhist  : Factor w/ 2 levels "Absent","Present": 2 1 2 2 2 2 1 2 2 2 ...
##  $ typea    : int  49 55 52 51 60 62 59 62 49 69 ...
##  $ obesity  : num  25.3 28.9 29.1 32 26 ...
##  $ alcohol  : num  97.2 2.06 3.81 24.26 57.34 ...
##  $ age      : int  52 63 46 58 49 45 38 58 29 53 ...
##  $ chd      : Factor w/ 2 levels "No","Si": 2 2 1 2 2 1 1 2 1 2 ...

D<-daisy(Datos, metric = "euclidean")

## Warning in daisy(Datos, metric = "euclidean"): with mixed variables, metric
## "gower" is used automatically

jer<-hclust(D, method = "complete")
grupos <- cutree(jer, k=3)
centro.cluster1<-centroide(1,Datos[,-c(5,10)],grupos)
centro.cluster2<-centroide(2,Datos[,-c(5,10)],grupos)
centro.cluster3<-centroide(3,Datos[,-c(5,10)],grupos)
centros<-rbind(centro.cluster1,centro.cluster2,centro.cluster3)

centros<-as.data.frame(centros)
maximos<-apply(centros,2,max)
minimos<-apply(centros,2,min)
centros<-rbind(minimos,centros)
centros<-rbind(maximos,centros)
centros

##                      sbp  tobacco      ldl adiposity    typea  obesity
## 1               144.3229 5.913281 5.866771  28.69698 54.56250 26.83281
## 11              135.4603 2.634735 4.344238  23.96911 52.36755 25.73745
## centro.cluster1 144.3229 5.265937 5.866771  28.69698 54.44792 26.83281
## centro.cluster2 142.8594 5.913281 4.919688  27.25516 54.56250 26.30813
## centro.cluster3 135.4603 2.634735 4.344238  23.96911 52.36755 25.73745
##                  alcohol      age
## 1               21.06146 51.55208
## 11              15.93136 38.85430
## centro.cluster1 21.06146 51.55208
## centro.cluster2 16.27094 48.40625
## centro.cluster3 15.93136 38.85430

color <- c("#FCEBB6","#78C0A8","#5E412F")

radarchart(as.data.frame(centros),maxmin=TRUE,axistype=4,axislabcol="slategray4",
             centerzero=FALSE,seg=8, cglcol="gray67",
             pcol=color,plty=1,plwd=5,title="Comparación de clústeres")
  
legenda <-legend(1.5,1, legend=c("Cluster 1","Cluster 2","Cluster 3"),
                seg.len=-1.4,title="Clústeres",pch=21,bty="n" ,lwd=3, y.intersp=1, 
                horiz=FALSE,col=color)

grupo <- cutree(jer, k = 3)
NDatos <- cbind(Datos, grupo)
cluster <- NDatos$grupo

sel.cluster1 <- match(cluster, 1, 0)
sel.cluster1[1:10]

##  [1] 1 0 0 1 1 0 0 1 0 1

Datos.Cluster1 <- NDatos[sel.cluster1 > 0,]
dim(Datos.Cluster1)

## [1] 96 11

sel.cluster2 <- match(cluster, 2, 0)
Datos.Cluster2 <- NDatos[sel.cluster2 > 0,]
dim(Datos.Cluster2)

## [1] 64 11

sel.cluster3 <- match(cluster, 3, 0)
Datos.Cluster3 <- NDatos[sel.cluster3 > 0,]
dim(Datos.Cluster3)

## [1] 302  11

Interpretación usando solamente las Variables Cualitativas (Categóricas)

color1 <- c("#ECD078","#D95B43")
plot(Datos$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Todos los Datos")

plot(Datos.Cluster1$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Cluster 1")

plot(Datos.Cluster2$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Cluster 2")

plot(Datos.Cluster3$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Cluster 3")

color2 <- c("#45ADA8","#9DE0AD")
plot(Datos$chd, col = color2, las = 2, main = "Variable chd", xlab = "Todos los Datos")

plot(Datos.Cluster1$chd, col = color2, las = 2, main = "Variable chd", xlab = "Cluster 1")

plot(Datos.Cluster2$chd, col = color2, las = 2, main = "Variable chd", xlab = "Cluster 2")

plot(Datos.Cluster3$chd, col = color2, las = 2, main = "Variable chd", xlab = "Cluster 3")